home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / bonus.arc / SCLOCK.LSP < prev    next >
Encoding:
Text File  |  1986-02-25  |  4.0 KB  |  104 lines
  1. ; update the hour & minute hand display
  2. (defun hrmn ()
  3.        (setq hour (* 100. (- time (fix time))))             ; get hour
  4.        (setq minute (* 100. (- hour (fix hour))))           ; get minute
  5.        (setq angle (- tp5pi (* mnfac minute)))
  6.        (setq mnmid (polar center angle mnhl))
  7.        (setq mnv2 (subst (cons '10 mnmid) (assoc '10 mnv2) mnv2))
  8.        (setq mnend (polar center angle mnlen))
  9.        (setq mnv3 (subst (cons '10 mnend) (assoc '10 mnv3) mnv3))
  10.        (setq hour (if (> hour 13.) (- hour 12.) hour))
  11.        (setq angle (- tp5pi (* hrfac hour)))
  12.        (setq hrend (polar center angle hrlen))
  13.        (setq hrmid (polar center angle hrhl))
  14.        (setq hrv2 (subst (cons '10 hrmid) (assoc '10 hrv2) hrv2))
  15.        (setq hrv3 (subst (cons '10 hrend) (assoc '10 hrv3) hrv3))
  16.        (entmod mnv2)
  17.        (entmod mnv3)
  18.        (entmod hrv2)
  19.        (entmod hrv3)
  20.        (entupd hrhand)
  21.        (entupd mnhand)
  22.        (setq timer (strcat (itoa (fix hour)) ":" (itoa (fix minute)) ":"))
  23. )
  24. ; update the second hand display
  25. (defun sec ()
  26.        (setq second (fix minute))
  27.        (setq end3 (polar center (- tp5pi (* mnfac second)) sclen))
  28.        (grdraw center start -1)               ; erase old sec hand
  29.        (setq start end3)
  30.        (if (> old second) (hrmn))             ; new minute?
  31.        (grdraw center end3 -1)                ; draw new one
  32.        (grtext -2 (strcat timer (itoa second)))  ; update digital display
  33.        (setq old second)
  34. )
  35. ; loop which runs the clock
  36. (defun go()
  37.        (repeat 32000
  38.                (setq time (getvar "CDATE"))               ; get time & date
  39.                (setq hour (* 10000. (- time (fix time)))) ; get hhmm.ss
  40.                (setq minute (* 100. (- hour (fix hour)))) ; now ss.mil
  41.                (if (/= (fix minute) (fix second)) (sec))
  42.        )
  43. )
  44. (defun c:run()
  45.        (command "regen")
  46.        (grdraw center start -1)
  47.        (setq old 60)
  48.        (terpri)
  49.        (prompt "CLOCK command via AutoLISP")
  50.        (terpri)
  51.        (go)
  52. )
  53. (defun rtd (a)
  54.        (* (/ a twopi) 360.)
  55. )
  56. ; clear screen, draw face & setup factors
  57. (defun c:clock ()
  58.        (expand 100)
  59.        (setvar "HIGHLIGHT" 0)
  60.        (setvar "BLIPMODE" 0)
  61.        (setvar "GRIDMODE" 0)
  62.        (setvar "FILLMODE" 1)
  63.        (setq twopi (* 2. pi))
  64.        (setq tp5pi (* 2.5 pi))
  65.        (setq hrfac (/ (* 2. pi) 12.))
  66.        (setq mnfac (/ (* 2. pi) 60.))
  67.        (setq center (getvar "VIEWCTR"))
  68.        (setq radius (* 0.45 (getvar "VIEWSIZE")))
  69.        (setq hrwid (* 0.04 radius))
  70.        (setq mnwid (* 0.02 radius))
  71.        (setq old 60)
  72.        (setq second 60)
  73.        (setq start (list (car center) (+ (cadr center) (* 0.9 radius))))
  74.        (command "ERASE" "W" (getvar "LIMMAX") (getvar "LIMMIN") "")
  75.        (grclear)
  76.        (command "CIRCLE" center radius)
  77.        (command "TRACE" hrwid start (list (car center) (+ (cadr center) radius)) "")
  78.        (command "ARRAY" start "" "Polar" center 12 360 "Yes")
  79.        (setq sclen (* 0.8 radius))
  80.        (setq mnlen (* 0.8 sclen))
  81.        (setq mnhl (* 0.75 mnlen))
  82.        (setq hrlen (* 0.8 mnlen))
  83.        (setq hrhl (* 0.75 hrlen))
  84.        (setq hrend (list (car center) (+ (cadr center) hrlen)))
  85.        (setq hrmid (list (car center) (+ (cadr center) hrhl)))
  86.        (setq mnend (list (+ (car center) mnlen) (cadr center)))
  87.        (setq mnmid (list (+ (car center) mnhl) (cadr center)))
  88.        (command "PLINE" center "WIDTH" 0. hrwid hrmid "WIDTH" hrwid 0. hrend "")
  89.        (setq hrhand (entlast))
  90.        (setq hrv2 (entget hrhand))
  91.        (setq hrv2 (entget (entnext (entnext hrhand))))
  92.        (setq hrv3 (entget (entnext (cdr (assoc '-1 hrv2)))))
  93.        (command "PLINE" center "WIDTH" 0. mnwid mnmid "WIDTH" mnwid 0. mnend "")
  94.        (setq mnhand (entlast))
  95.        (setq mnv2 (entget mnhand))
  96.        (setq mnv2 (entget (entnext (entnext mnhand))))
  97.        (setq mnv3 (entget (entnext (cdr (assoc '-1 mnv2)))))
  98.        (grdraw center start -1)
  99.        (terpri)
  100.        (prompt "CLOCK command via AutoLISP")
  101.        (terpri)
  102.        (go)
  103. )
  104.